home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / mtrace < prev    next >
Encoding:
Text File  |  2009-10-07  |  6.3 KB  |  239 lines
  1. #! /usr/bin/perl
  2. eval "exec /usr/bin/perl -S $0 $@"
  3.     if 0;
  4. # Copyright (C) 1997-2008, 2009 Free Software Foundation, Inc.
  5. # This file is part of the GNU C Library.
  6. # Contributed by Ulrich Drepper <drepper@gnu.org>, 1997.
  7. # Based on the mtrace.awk script.
  8.  
  9. # The GNU C Library is free software; you can redistribute it and/or
  10. # modify it under the terms of the GNU Lesser General Public
  11. # License as published by the Free Software Foundation; either
  12. # version 2.1 of the License, or (at your option) any later version.
  13.  
  14. # The GNU C Library is distributed in the hope that it will be useful,
  15. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  16. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  17. # Lesser General Public License for more details.
  18.  
  19. # You should have received a copy of the GNU Lesser General Public
  20. # License along with the GNU C Library; if not, write to the Free
  21. # Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
  22. # 02111-1307 USA.
  23.  
  24. $VERSION = "2.10.1";
  25. $PKGVERSION = "(EGLIBC) ";
  26. $REPORT_BUGS_TO = '<http://www.eglibc.org/issues/>';
  27. $progname = $0;
  28.  
  29. sub usage {
  30.     print "Usage: mtrace [OPTION]... [Binary] MtraceData\n";
  31.     print "  --help       print this help, then exit\n";
  32.     print "  --version    print version number, then exit\n";
  33.     print "\n";
  34.     print "For bug reporting instructions, please see:\n";
  35.     print "$REPORT_BUGS_TO.\n";
  36.     exit 0;
  37. }
  38.  
  39. # We expect two arguments:
  40. #   #1: the complete path to the binary
  41. #   #2: the mtrace data filename
  42. # The usual options are also recognized.
  43.  
  44. arglist: while (@ARGV) {
  45.     if ($ARGV[0] eq "--v" || $ARGV[0] eq "--ve" || $ARGV[0] eq "--ver" ||
  46.     $ARGV[0] eq "--vers" || $ARGV[0] eq "--versi" ||
  47.     $ARGV[0] eq "--versio" || $ARGV[0] eq "--version") {
  48.     print "mtrace $PKGVERSION$VERSION\n";
  49.     print "Copyright (C) 2009 Free Software Foundation, Inc.\n";
  50.     print "This is free software; see the source for copying conditions.  There is NO\n";
  51.     print "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n";
  52.     print "Written by Ulrich Drepper <drepper\@gnu.org>\n";
  53.  
  54.     exit 0;
  55.     } elsif ($ARGV[0] eq "--h" || $ARGV[0] eq "--he" || $ARGV[0] eq "--hel" ||
  56.          $ARGV[0] eq "--help") {
  57.     &usage;
  58.     } elsif ($ARGV[0] =~ /^-/) {
  59.     print "$progname: unrecognized option `$ARGV[0]'\n";
  60.     print "Try `$progname --help' for more information.\n";
  61.     exit 1;
  62.     } else {
  63.     last arglist;
  64.     }
  65. }
  66.  
  67. if ($#ARGV == 0) {
  68.     $binary="";
  69.     $data=$ARGV[0];
  70. } elsif ($#ARGV == 1) {
  71.     $binary=$ARGV[0];
  72.     $data=$ARGV[1];
  73.  
  74.     if ($binary =~ /^.*[\/].*$/) {
  75.     $prog = $binary;
  76.     } else {
  77.     $prog = "./$binary";
  78.     }
  79.     if (open (LOCS, "env LD_TRACE_LOADED_OBJECTS=1 $prog |")) {
  80.     while (<LOCS>) {
  81.         chop;
  82.         if (/^.*=> (.*) .(0x[0123456789abcdef]*).$/) {
  83.         $locs{$1} = $2;
  84.         }
  85.     }
  86.     close (LOCS);
  87.     }
  88. } else {
  89.     die "Wrong number of arguments, run $progname --help for help.";
  90. }
  91.  
  92. sub location {
  93.     my $str = pop(@_);
  94.     return $str if ($str eq "");
  95.     if ($str =~ /.*[[](0x[^]]*)]:(.)*/) {
  96.     my $addr = $1;
  97.     my $fct = $2;
  98.     return $cache{$addr} if (exists $cache{$addr});
  99.     if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) {
  100.         my $line = <ADDR>;
  101.         chomp $line;
  102.         close (ADDR);
  103.         if ($line ne '??:0') {
  104.         $cache{$addr} = $line;
  105.         return $cache{$addr};
  106.         }
  107.     }
  108.     $cache{$addr} = $str = "$fct @ $addr";
  109.     } elsif ($str =~ /^(.*):.*[[](0x[^]]*)]$/) {
  110.     my $prog = $1;
  111.     my $addr = $2;
  112.     my $searchaddr;
  113.     return $cache{$addr} if (exists $cache{$addr});
  114.     if ($locs{$prog} ne "") {
  115.         $searchaddr = sprintf "%#x", $addr - $locs{$prog};
  116.     } else {
  117.         $searchaddr = $addr;
  118.         $prog = $binary;
  119.     }
  120.     if ($binary ne "" && open (ADDR, "addr2line -e $prog $searchaddr|")) {
  121.         my $line = <ADDR>;
  122.         chomp $line;
  123.         close (ADDR);
  124.         if ($line ne '??:0') {
  125.         $cache{$addr} = $line;
  126.         return $cache{$addr};
  127.         }
  128.     }
  129.     $cache{$addr} = $str = $addr;
  130.     } elsif ($str =~ /^.*[[](0x[^]]*)]$/) {
  131.     my $addr = $1;
  132.     return $cache{$addr} if (exists $cache{$addr});
  133.     if ($binary ne "" && open (ADDR, "addr2line -e $binary $addr|")) {
  134.         my $line = <ADDR>;
  135.         chomp $line;
  136.         close (ADDR);
  137.         if ($line ne '??:0') {
  138.         $cache{$addr} = $line;
  139.         return $cache{$addr};
  140.         }
  141.     }
  142.     $cache{$addr} = $str = $addr;
  143.     }
  144.     return $str;
  145. }
  146.  
  147. $nr=0;
  148. open(DATA, "<$data") || die "Cannot open mtrace data file";
  149. while (<DATA>) {
  150.     my @cols = split (' ');
  151.     my $n, $where;
  152.     if ($cols[0] eq "@") {
  153.     # We have address and/or function name.
  154.     $where=$cols[1];
  155.     $n=2;
  156.     } else {
  157.     $where="";
  158.     $n=0;
  159.     }
  160.  
  161.     $allocaddr=$cols[$n + 1];
  162.     $howmuch=hex($cols[$n + 2]);
  163.  
  164.     ++$nr;
  165.     SWITCH: {
  166.     if ($cols[$n] eq "+") {
  167.         if (defined $allocated{$allocaddr}) {
  168.         printf ("+ %#010x Alloc %d duplicate: %s %s\n",
  169.             hex($allocaddr), $nr, &location($addrwas{$allocaddr}),
  170.             $where);
  171.         } else {
  172.         $allocated{$allocaddr}=$howmuch;
  173.         $addrwas{$allocaddr}=$where;
  174.         }
  175.         last SWITCH;
  176.     }
  177.     if ($cols[$n] eq "-") {
  178.         if (defined $allocated{$allocaddr}) {
  179.         undef $allocated{$allocaddr};
  180.         undef $addrwas{$allocaddr};
  181.         } else {
  182.         printf ("- %#010x Free %d was never alloc'd %s\n",
  183.             hex($allocaddr), $nr, &location($where));
  184.         }
  185.         last SWITCH;
  186.     }
  187.     if ($cols[$n] eq "<") {
  188.         if (defined $allocated{$allocaddr}) {
  189.         undef $allocated{$allocaddr};
  190.         undef $addrwas{$allocaddr};
  191.         } else {
  192.         printf ("- %#010x Realloc %d was never alloc'd %s\n",
  193.             hex($allocaddr), $nr, &location($where));
  194.         }
  195.         last SWITCH;
  196.     }
  197.     if ($cols[$n] eq ">") {
  198.         if (defined $allocated{$allocaddr}) {
  199.         printf ("+ %#010x Realloc %d duplicate: %#010x %s %s\n",
  200.             hex($allocaddr), $nr, $allocated{$allocaddr},
  201.             &location($addrwas{$allocaddr}), &location($where));
  202.         } else {
  203.         $allocated{$allocaddr}=$howmuch;
  204.         $addrwas{$allocaddr}=$where;
  205.         }
  206.         last SWITCH;
  207.     }
  208.     if ($cols[$n] eq "=") {
  209.         # Ignore "= Start".
  210.         last SWITCH;
  211.     }
  212.     if ($cols[$n] eq "!") {
  213.         # Ignore failed realloc for now.
  214.         last SWITCH;
  215.     }
  216.     }
  217. }
  218. close (DATA);
  219.  
  220. # Now print all remaining entries.
  221. @addrs= keys %allocated;
  222. $anything=0;
  223. if ($#addrs >= 0) {
  224.     foreach $addr (sort @addrs) {
  225.     if (defined $allocated{$addr}) {
  226.         if ($anything == 0) {
  227.         print "\nMemory not freed:\n-----------------\n";
  228.         print ' ' x (10 - 7), "Address     Size     Caller\n";
  229.         $anything=1;
  230.         }
  231.         printf ("%#010x %#8x  at %s\n", hex($addr), $allocated{$addr},
  232.             &location($addrwas{$addr}));
  233.     }
  234.     }
  235. }
  236. print "No memory leaks.\n" if ($anything == 0);
  237.  
  238. exit $anything != 0;
  239.